Initial commit

.gitignore

+.stack-work/
+*~
\ No newline at end of file

.gitlab-ci.dhall

+let GitLab = https://gitlab.homotopic.tech/dhall/gitlab/-/raw/789b1d08cdf797cfa0e3b4ab2695fdba1e8de8e3/package.dhall
+
+in  GitLab.Top.toJSON GitLab.stack-pipeline

.gitlab-ci.yml

+gitlab:
+  allow_failure: false
+  script:
+    - "dhall-to-yaml --file .gitlab-ci.dhall > .gitlab-ci.yml"
+    - |2
+       if [ -z $(git status --porcelain) ]; then
+         echo "GitLab CI file OK"
+       else
+         echo "GitLab CI file is bad, please regenerate it with dhall-to-yaml --file .gitlab-ci.dhall > .gitlab-ci.yml"
+         git --no-pager diff
+         exit 1
+       fi
+  stage: confirm
+  variables: {}
+hlint:
+  allow_failure: false
+  script:
+    - hlint .
+  stage: lint
+  variables: {}
+ormolu:
+  allow_failure: false
+  script:
+    - "find . -name \"*.hs\" | xargs -I x ormolu -i x"
+    - |2
+       if [ -z $(git status --porcelain) ]; then
+         echo "Ormolu Style Check OK"
+       else
+         echo "Haskell files are not styled properly, fix with find . -name "*.hs" | xargs -I x ormolu -i x."
+         git --no-pager diff
+         exit 1
+       fi
+  stage: lint
+  variables: {}
+stack-build:
+  allow_failure: false
+  script:
+    - "stack --nix build --ghc-options \"-Werror\""
+  stage: build
+  variables: {}
+stack-haddock:
+  allow_failure: false
+  script:
+    - stack --nix haddock
+  stage: docs
+  variables: {}
+stack-test:
+  allow_failure: false
+  script:
+    - "stack --nix test --ghc-options \"-Werror\""
+  stage: test
+  variables: {}
+stages:
+  - confirm
+  - lint
+  - build
+  - test
+  - docs
+variables:
+  GIT_SUBMODULE_STRATEGY: normal

ChangeLog.md

+# Changelog for anki-connect
+
+## v0.0.1.0
+
+* Experimental bindings to anki-connect.

LICENSE

+Copyright Daniel Firth (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Daniel Firth nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

+# anki-connect
+
+Bindings to anki-connect. Launch anki with anki-connect available
+and run:
+
+```
+runAnkiConnectV6 @CreateDeck (DeckNameInput "foo")
+```
+
+Limited API endpoints available currently.

anki-connect.cabal

+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           anki-connect
+version:        0.1.0.0
+synopsis:       Bindings to anki-connect
+description:    Bindings to anki-connect
+category:       Web
+author:         Daniel Firth
+maintainer:     dan.firth@homotopic.tech
+copyright:      Daniel Firth
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://gitlab.homotopic.tech/haskell/anki-connect
+
+library
+  exposed-modules:
+      Anki.Connect
+  other-modules:
+      Paths_anki_connect
+  hs-source-dirs:
+      src
+  default-extensions:
+      DataKinds
+      FlexibleContexts
+      OverloadedStrings
+      TypeApplications
+  build-depends:
+      aeson
+    , base >=4.7 && <5
+    , containers
+    , http-conduit
+    , text
+  default-language: Haskell2010

package.yaml

+name:                anki-connect
+version:             0.1.0.0
+git:                 https://gitlab.homotopic.tech/haskell/anki-connect
+license:             BSD3
+author:              "Daniel Firth"
+maintainer:          "dan.firth@homotopic.tech"
+copyright:           "Daniel Firth"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+default-extensions:
+- DataKinds
+- FlexibleContexts
+- OverloadedStrings
+- TypeApplications
+
+synopsis:            Bindings to anki-connect
+category:            Web
+
+description:         Bindings to anki-connect
+
+dependencies:
+- aeson
+- base >= 4.7 && < 5
+- containers
+- http-conduit
+- text
+
+library:
+  source-dirs: src

src/Anki/Connect.hs

+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Anki.Connect where
+
+import Control.Monad.IO.Class
+import Data.Aeson
+import Data.Functor.Identity
+import Data.Kind
+import Data.Map
+import Data.Text
+import GHC.Generics
+import GHC.TypeLits
+import Network.HTTP.Conduit
+import Network.HTTP.Simple
+
+type CardId = Int
+
+type DeckName = Text
+
+type DeckId = Int
+
+type ModelName = Text
+
+type ModelId = Int
+
+type NoteId = Int
+
+type EaseFactor = Int
+
+newtype CardIdInput = CardIdInput
+  { card :: CardId
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data SetEaseFactorsInput = SetEaseFactorsInput
+  { cards :: [CardId],
+    easeFactors :: [EaseFactor]
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data LapseData = LapseData
+  { leechFails :: Int,
+    delays :: [Int],
+    minInt :: Int,
+    leechAction :: Int,
+    mult :: Int
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data NewData = NewData
+  { bury :: Bool,
+    order :: Int,
+    initialFactor :: Int,
+    perDay :: Int,
+    delays :: [Int],
+    separate :: Bool,
+    ints :: [Int]
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data DeckConfig = DeckConfig
+  { lapse :: LapseData,
+    dyn :: Bool,
+    autoplay :: Bool,
+    mod :: Int,
+    id :: Int,
+    maxTaken :: Int,
+    new :: NewData,
+    name :: Text,
+    rev :: RevData,
+    timer :: Int,
+    replayq :: Bool,
+    usn :: Int
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data RevData = RevData
+  { bury :: Bool,
+    ivlFct :: Int,
+    ease4 :: Double,
+    maxIvl :: Int,
+    perDay :: Int,
+    minSpace :: Int,
+    fuzz :: Double
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data AnkiRequestNoParams = AnkiRequestNoParams
+  { action :: String,
+    version :: Int
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data AnkiRequestWithParams a = AnkiRequestWithParams
+  { action :: String,
+    version :: Int,
+    params :: a
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+newtype CardIdsInput = CardsInput
+  { cards :: [CardId]
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data ChangeDeckInput = ChangeDeckInput
+  { deck :: DeckName,
+    cards :: [CardId]
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+newtype DeckNameInput = DeckNameInput
+  { deck :: DeckName
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data DeleteDecksInput = DeleteDecksInput
+  { decks :: [DeckName],
+    cardsToo :: Bool
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+newtype QueryInput = QueryInput
+  { query :: Text
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+newtype ImportPackageInput = ImportPackageInput
+  { path :: FilePath
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data ExportPackageInput = ExportPackageInput
+  { deck :: DeckName,
+    path :: FilePath,
+    includeSched :: Bool
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data FieldData = FieldData
+  { value :: Text,
+    order :: Int
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data CardInfo = CardInfo
+  { answer :: Text,
+    question :: Text,
+    deckName :: DeckName,
+    modelName :: ModelName,
+    fieldOrder :: Int,
+    fields :: Map Text FieldData,
+    css :: Text,
+    cardId :: CardId,
+    interval :: Int,
+    note :: NoteId,
+    ord :: Int,
+    type_ :: Int,
+    queue :: Int,
+    due :: Int,
+    reps :: Int,
+    lapses :: Int,
+    left :: Int
+  }
+  deriving stock (Eq, Show, Generic)
+
+instance FromJSON CardInfo where
+  parseJSON = withObject "CardInfo" $ \v ->
+    CardInfo
+      <$> v .: "answer"
+      <*> v .: "question"
+      <*> v .: "deckName"
+      <*> v .: "modelName"
+      <*> v .: "fieldOrder"
+      <*> v .: "fields"
+      <*> v .: "css"
+      <*> v .: "cardId"
+      <*> v .: "interval"
+      <*> v .: "note"
+      <*> v .: "ord"
+      <*> v .: "type"
+      <*> v .: "queue"
+      <*> v .: "due"
+      <*> v .: "reps"
+      <*> v .: "lapses"
+      <*> v .: "left"
+
+data StoreMediaFileInput = Data StoreMediaFileDataInput | File StoreMediaFilePathInput | Url StoreMediaFileUrlInput
+
+data StoreMediaFileDataInput = StoreMediaFileDataInput
+  { filename :: Text,
+    data_ :: Text
+  }
+
+instance ToJSON StoreMediaFileDataInput where
+  toJSON (StoreMediaFileDataInput f x) =
+    object ["filename" .= f, "data" .= x]
+
+data StoreMediaFilePathInput = StoreMediaFilePathInput
+  { filename :: Text,
+    path :: FilePath
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data StoreMediaFileUrlInput = StoreMediaFileUrlInput
+  { filename :: Text,
+    url :: Text
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data Anki = Anki Symbol (Maybe Type) (Maybe Type)
+
+-- * Card Actions
+
+type GetEaseFactors = 'Anki "getEaseFactors" (Just CardIdsInput) (Just [EaseFactor])
+
+type SetEaseFactors = 'Anki "setEaseFactors" (Just SetEaseFactorsInput) (Just [Bool])
+
+type Suspend = 'Anki "suspend" (Just CardIdsInput) (Just Bool)
+
+type Unsuspend = 'Anki "unsuspend" (Just CardIdsInput) (Just Bool)
+
+type Suspended = 'Anki "suspended" (Just CardIdInput) (Just Bool)
+
+type AreSuspended = 'Anki "areSuspended" (Just CardIdsInput) (Just (Maybe Bool))
+
+type AreDue = 'Anki "areDue" (Just CardIdsInput) (Just Bool)
+
+type GetIntervals = 'Anki "getIntervals" (Just CardIdsInput) (Just [Int])
+
+type FindCards = 'Anki "findCards" (Just QueryInput) (Just [CardId])
+
+type CardsToNotes = 'Anki "cardsToNotes" (Just CardIdsInput) (Just [NoteId])
+
+type CardsInfo = 'Anki "cardsInfo" (Just CardIdsInput) (Just [CardInfo])
+
+type ForgetCards = 'Anki "forgetCards" (Just CardIdsInput) Nothing
+
+type RelearnCards = 'Anki "relearnCards" (Just CardIdsInput) Nothing
+
+-- * Deck Actions
+
+type DeckNames = 'Anki "deckNames" Nothing (Just [Text])
+
+type DeckNamesAndIds = 'Anki "deckNamesAndIds" Nothing (Just (Map DeckName DeckId))
+
+type GetDecks = 'Anki "getDecks" (Just CardIdsInput) (Just (Map DeckName [CardId]))
+
+type CreateDeck = 'Anki "createDeck" (Just DeckNameInput) (Just DeckId)
+
+type ChangeDeck = 'Anki "changeDeck" (Just ChangeDeckInput) Nothing
+
+type DeleteDecks = 'Anki "deleteDecks" (Just DeleteDecksInput) Nothing
+
+type GetDeckConfig = 'Anki "getDeckConfig" (Just DeckNameInput) (Just DeckConfig)
+
+type SaveDeckConfig = 'Anki "saveDeckConfig" (Just DeckConfig) (Just Bool)
+
+type ExportPackage = 'Anki "exportPackage" (Just ExportPackageInput) (Just Bool)
+
+type ImportPackage = 'Anki "importPackage" (Just ImportPackageInput) (Just Bool)
+
+type ReloadCollection = 'Anki "reloadCollection" Nothing Nothing
+
+type ModelNames = 'Anki "modelNames" Nothing (Just [ModelName])
+
+type ModelNamesAndIds = 'Anki "modelNamesAndIds" Nothing (Just (Map ModelName ModelId))
+
+-- * Gui Actions
+
+type GuiBrowse = 'Anki "guiBrowse" (Just QueryInput) (Just [CardId])
+
+-- * Media Actions
+
+type StoreMediaFile = 'Anki "storeMediaFile" (Just StoreMediaFileInput) (Just FilePath)
+
+class AnkiConnectV6 s where
+  type AnkiRequestSig s
+  runAnkiConnectV6 :: AnkiRequestSig s
+
+instance KnownSymbol s => AnkiConnectV6 ('Anki s Nothing Nothing) where
+  type AnkiRequestSig ('Anki s Nothing Nothing) = IO (Either AnkiConnectError ())
+  runAnkiConnectV6 = do
+    let x = AnkiRequestNoParams {action = symbolVal @s undefined, version = 6}
+    x <- httpJSONEither . toConduitRequest @AnkiRequestNoParams $ x
+    let z = getResponseBody x
+    let l = case z of
+          Left e -> Left $ AnkiConnectJSONError e
+          Right (NoResult x) -> case x of
+            Just e -> Left $ AnkiReportedError e
+            Nothing -> Right ()
+    pure l
+
+instance (ToJSON i, KnownSymbol s) => AnkiConnectV6 ('Anki s (Just i) Nothing) where
+  type AnkiRequestSig ('Anki s (Just i) Nothing) = i -> IO (Either AnkiConnectError ())
+  runAnkiConnectV6 p = do
+    let x = AnkiRequestWithParams {action = symbolVal @s undefined, version = 6, params = p}
+    x <- httpJSONEither . toConduitRequest @(AnkiRequestWithParams i) $ x
+    let z = getResponseBody x
+    let l = case z of
+          Left e -> Left $ AnkiConnectJSONError e
+          Right (NoResult x) -> case x of
+            Just e -> Left $ AnkiReportedError e
+            Nothing -> Right ()
+    pure l
+
+instance (FromJSON o, KnownSymbol s) => AnkiConnectV6 ('Anki s Nothing (Just o)) where
+  type AnkiRequestSig ('Anki s Nothing (Just o)) = IO (Either AnkiConnectError o)
+  runAnkiConnectV6 = do
+    let x = AnkiRequestNoParams {action = symbolVal @s undefined, version = 6}
+    x <- httpJSONEither . toConduitRequest @AnkiRequestNoParams $ x
+    let z = getResponseBody x
+    let l = case z of
+          Left e -> Left $ AnkiConnectJSONError e
+          Right (AnkiRawResponse x e) -> case e of
+            Just e -> Left $ AnkiReportedError e
+            Nothing -> case x of
+              Just x -> Right x
+              Nothing -> Left UnknownAnkiConnectError
+    pure l
+
+instance (ToJSON i, FromJSON o, KnownSymbol s) => AnkiConnectV6 ('Anki s (Just i) (Just o)) where
+  type AnkiRequestSig ('Anki s (Just i) (Just o)) = i -> IO (Either AnkiConnectError o)
+  runAnkiConnectV6 p = do
+    let x = AnkiRequestWithParams {action = symbolVal @s undefined, version = 6, params = p}
+    x <- httpJSONEither . toConduitRequest @(AnkiRequestWithParams i) $ x
+    let z = getResponseBody x
+    let l = case z of
+          Left e -> Left $ AnkiConnectJSONError e
+          Right (AnkiRawResponse x e) -> case e of
+            Just e -> Left $ AnkiReportedError e
+            Nothing -> case x of
+              Just x -> Right x
+              Nothing -> Left UnknownAnkiConnectError
+    pure l
+
+toConduitRequest :: ToJSON a => a -> Request
+toConduitRequest x = setRequestBodyJSON x $ defaultRequest {method = "POST", host = "localhost", port = 8765}
+
+data AnkiRawResponse a = AnkiRawResponse
+  { result :: Maybe a,
+    error :: Maybe Text
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+newtype NoResult = NoResult {error :: Maybe Text}
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data AnkiConnectError where
+  AnkiConnectJSONError :: JSONException -> AnkiConnectError
+  AnkiReportedError :: Text -> AnkiConnectError
+  UnknownAnkiConnectError :: AnkiConnectError
+
+deriving stock instance Show AnkiConnectError

stack.yaml

+resolver: lts-18.10
+packages:
+- .
+extra-deps:
+- composite-base-0.7.5.0
+- fcf-containers-0.6.0
+allow-newer: true

stack.yaml.lock

+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: composite-base-0.7.5.0@sha256:3c754bca3a1a673e1f0ba9fa88850dd8c650b5a7140dc5afca09bb86e4843c17,2955
+    pantry-tree:
+      size: 604
+      sha256: 504ed3870d3ee32a008f24ac6e1cc5686c201900008499c294fb1b7cdcef9648
+  original:
+    hackage: composite-base-0.7.5.0
+- completed:
+    hackage: fcf-containers-0.6.0@sha256:4c9e82666afe2093e1d26cecf76aed315902f73653e735df6b82391117bf995e,3042
+    pantry-tree:
+      size: 1518
+      sha256: 5648be63d1cc2845568291aba1143f304fc78e142860628bc7daa12e7562e288
+  original:
+    hackage: fcf-containers-0.6.0
+snapshots:
+- completed:
+    size: 587546
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/10.yaml
+    sha256: 88b4f81e162ba3adc230a9fcccc4d19ac116377656bab56c7382ca88598b257a
+  original: lts-18.10