diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Al Zohali + +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 Al Zohali 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/anki-tools.cabal b/anki-tools.cabal new file mode 100644 --- /dev/null +++ b/anki-tools.cabal @@ -0,0 +1,70 @@ +name: anki-tools +version: 0.1.0.0 +synopsis: Tools for interacting with Anki database +-- description: +license: BSD3 +license-file: LICENSE +author: Al Zohali +maintainer: zohl@fmap.me +-- copyright: +category: Database +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/zohl/anki-tools.git + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + exposed-modules: + Anki.Tools + Anki.Collection + Anki.Common + Anki.Model + Anki.Deck + Anki.Note + Anki.Card + Anki.Misc + Anki.UserProfile + + build-depends: base >=4.8 && < 5.0 + , aeson + , bytestring + , data-default + , directory + , exceptions + , filepath + , mtl + , scientific + , sqlite-simple + , time + , text + , unordered-containers + + hs-source-dirs: src + default-language: Haskell2010 + + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + + +executable anki-tools-test + hs-source-dirs: test + main-is: Main.hs + build-depends: base >= 4.7 && < 5.0 + , anki-tools + , data-default + + default-language: Haskell2010 + + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall diff --git a/src/Anki/Card.hs b/src/Anki/Card.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Card.hs @@ -0,0 +1,71 @@ +{-| + Module: Anki.Card + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Representation of a card and related definitions. +-} + +{-# LANGUAGE DeriveGeneric #-} + +module Anki.Card ( + CardId + , Card(..) + ) where + + +import Anki.Common (ModificationTime) +import Anki.Deck (DeckId) +import Anki.Note (NoteId) +import Data.Text (Text) +import Database.SQLite.Simple (FromRow(..), field) +import GHC.Generics (Generic) + +-- | Type for card ids. +type CardId = Int + +-- | Cards from cards table. +data Card = Card { + cardId :: CardId + , cardNid :: NoteId + , cardDid :: DeckId + , cardOrd :: Int -- TODO check type + , cardMod :: ModificationTime + , cardUsn :: Int -- TODO check type + , cardType :: Int -- TODO check type + , cardQueue :: Int -- TODO check type + , cardDue :: Int -- TODO check type + , cardIvl :: Int -- TODO check type + , cardFactor :: Int -- TODO check type + , cardReps :: Int -- TODO check type + , cardLapses :: Int -- TODO check type + , cardLeft :: Int -- TODO check type + , cardOdue :: Int -- TODO check type + , cardOdid :: Int -- TODO check type + , cardFlags :: Int -- TODO check type + , cardData :: Text -- TODO check type + } deriving (Show, Eq, Generic) + +instance FromRow Card where + fromRow = Card + <$> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field diff --git a/src/Anki/Collection.hs b/src/Anki/Collection.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Collection.hs @@ -0,0 +1,110 @@ +{-| + Module: Anki.Collection + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Representation of a collection and related definitions. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleInstances #-} + +module Anki.Collection ( + Collection(..) + , GlobalOptions(..) + , Tag(..) + ) where + + +import Anki.Common (ModificationTime, AnkiException(..), throwErr) +import Anki.Common (dropPrefixOptions, getTextValue, getJsonValue, fromDictionary) +import Anki.Deck (DeckId, Deck, DeckOptions) +import Anki.Model (ModelId, Model) +import Data.Aeson (Value(..), decode, FromJSON(..), genericParseJSON) +import Data.Text (Text) +import Database.SQLite.Simple (FromRow(..), field) +import Database.SQLite.Simple.FromField (FromField(..)) +import Database.SQLite.Simple.Internal (Field(..)) +import Database.SQLite.Simple.Ok (Ok(..)) +import GHC.Generics (Generic) +import qualified Data.Text as T + + +-- | Collection as in col table. +data Collection = Collection { + collectionId :: Int -- ^ collection identifier (id) + , collectionCrt :: Int -- TODO check type + , collectionMod :: ModificationTime + , collectionScm :: Int -- TODO check type + , collectionVer :: Int -- TODO check type + , collectionDty :: Int -- TODO check type + , collectionUsn :: Int -- TODO check type + , collectionLs :: Int -- TODO check type + , collectionGlobalOptions :: GlobalOptions -- ^ global options (col.conf) + , collectionModels :: [Model] -- ^ models in the collection(col.models) + , collectionDecks :: [Deck] -- ^ decks in the collection (col.decks) + , collectionDeckOptions :: [DeckOptions] -- ^ deck options (col.dconf) + , collectionTags :: [Tag] -- ^ tags (col.tags) + } deriving (Show, Eq, Generic) + +instance FromRow Collection where + fromRow = Collection + <$> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + + +-- | Global opitions. +data GlobalOptions = GlobalOptions { + goNextPos :: Value -- TODO Int? + , goEstTimes :: Value -- TODO Bool? + , goSortBackwards :: Value -- TODO Bool? + , goSortType :: Value -- TODO String? + , goTimeLim :: Value -- TODO Int? + , goActiveDecks :: [DeckId] -- ^ TODO + , goAddToCur :: Value -- TODO Bool? + , goCurDeck :: Value -- TODO DeckId? + , goCurModel :: ModelId -- ^ TODO + , goLastUnburied :: Value -- TODO Int? + , goCollapseTime :: Value -- TODO Int? + , goActiveCols :: Value -- TODO [String]? + , goSavedFilters :: Value -- TODO [wtf]? + , goDueCounts :: Value -- TODO Bool? + , goNewBury :: Value -- TODO Bool? + , goNewSpread :: Value -- TODO Int? + } deriving (Show, Eq, Generic) + +instance FromJSON GlobalOptions where + parseJSON = genericParseJSON dropPrefixOptions + +instance FromField GlobalOptions where + fromField f = getTextValue f >>= maybe (throwErr f WrongJsonFormat) return . decode + + +-- | Tags from col.tags. +data Tag = Tag { + tagName :: String -- ^ tag name (key) + , tagNumber :: Int -- ^ TODO: wtf? (value) + } deriving (Show, Eq) + +instance FromField [Tag] where + fromField f = getJsonValue f >>= fromDictionary mkTag f where + mkTag :: Field -> (Text, Value) -> Ok Tag + mkTag f' = \case + (name, Number number) -> return $ Tag (T.unpack name) (round number) + _ -> throwErr f' WrongJsonFormat + diff --git a/src/Anki/Common.hs b/src/Anki/Common.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Common.hs @@ -0,0 +1,159 @@ +{-| + Module: Anki.Common + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Auxiliary functions and types. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Anki.Common ( + AnkiException(..) + , WeaklyTypedInt(..) + , WeaklyTypedBool(..) + , ModificationTime(..) + , throwErr + , getTextValue + , getJsonValue + , fromDictionary + , mkEntry + , dropPrefixOptions + ) where + + +import Control.Exception (Exception) +import Control.Monad (unless) +import Data.Aeson (Value(..), encode, decode, FromJSON(..)) +import Data.Aeson.Types (Options(..), defaultOptions) +import Data.Char (toLower, isUpper) +import Data.HashMap.Strict (toList) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Typeable (Typeable) +import Database.SQLite.Simple (SQLData(..)) +import Database.SQLite.Simple.FromField (FromField(..), ResultError(..), returnError) +import Database.SQLite.Simple.Internal (Field(..)) +import Database.SQLite.Simple.Ok (Ok(..)) +import qualified Data.ByteString.Lazy.Char8 as BSLC8 +import qualified Data.Text as T + + +-- | The exception is thrown when something goes wrong with this package. +data AnkiException + = WrongFieldType + -- ^ Thrown when column type is not a text. + | NotJson + -- ^ Thrown when text from database is not a valid json. + | WrongJsonFormat + -- ^ Thrown when json format differs from expected one. + | ModelIdInconsistent + -- ^ Thrown when external and internal ids of model differ. + | DeckIdInconsistent + -- ^ Thrown when external and internal ids of deck differ. + | DeckOptionsIdInconsistent + -- ^ Thrown when external and internal ids of deck options differ. + deriving (Eq, Show, Typeable) + +instance (Exception AnkiException) + +-- | Exit from Ok monad. +throwErr :: (Typeable a) => Field -> AnkiException -> Ok a +throwErr f ex = returnError ConversionFailed f $ show ex + +-- | Read field as a byte sequence. +getTextValue :: Field -> Ok BSLC8.ByteString +getTextValue = \case + (Field (SQLText txt) _) -> return . BSLC8.pack . T.unpack $ txt + f -> throwErr f WrongFieldType + +-- | Read field as a JSON. +getJsonValue :: Field -> Ok Value +getJsonValue f = getTextValue f >>= getValue where + getValue :: BSLC8.ByteString -> Ok Value + getValue = maybe (throwErr f NotJson) return . decode + +-- | Transform a JSON-dictionary to a list of values. +fromDictionary :: (Typeable a) => (Field -> (Text, Value) -> Ok a) -> Field -> Value -> Ok [a] +fromDictionary mkEntry' f = \case + (Object o) -> mapM (mkEntry' f) (toList o) + _ -> throwErr f WrongJsonFormat + +-- | Transform a single pair from JSON-dictionary of type { : {id: , ....} } to a record. +mkEntry :: (Typeable a, FromJSON a, Eq b, Typeable b, FromJSON b) + => (a -> b) + -> AnkiException + -> Field + -> (Text, Value) + -> Ok a + +mkEntry entryId entryIdException f (key, value) = do + entryId' <- maybe + (throwErr f WrongJsonFormat) + return + (decode . BSLC8.pack . T.unpack $ key) + + entry <- maybe + (throwErr f WrongJsonFormat) + return + (decode . encode $ value) + + unless (entryId' == entryId entry) $ throwErr f entryIdException + return entry + +-- | Cut the first word and lowercase the second. +dropPrefix :: String -> String +dropPrefix "" = "" +dropPrefix (c:t) + | isUpper c = toLower c : t + | otherwise = dropPrefix t + +-- | Default options used in Aeson typeclasses in this module. +dropPrefixOptions :: Options +dropPrefixOptions = defaultOptions { fieldLabelModifier = dropPrefix } + +-- | A wrapper to handle integers and strings with integers. +newtype WeaklyTypedInt = WeaklyTypedInt { getInt :: Int } deriving (Show, Eq, Num) + +instance FromJSON WeaklyTypedInt where + parseJSON = fmap fromInteger . \case + (String s) -> return . read . T.unpack $ s + (Number x) -> return . round $ x + _ -> error "TODO" + +instance FromField WeaklyTypedInt where + fromField f = fromInteger <$> fromField f + +-- | A wrapper to handle booleans, strings with booleans and 0-1 integers. +newtype WeaklyTypedBool = WeaklyTypedBool { getBool :: Bool } deriving (Show, Eq) + +instance FromJSON WeaklyTypedBool where + parseJSON = fmap WeaklyTypedBool . \case + (String s) -> case s of + "false" -> return False + "true" -> return True + _ -> error "TODO" + + (Number x) -> case x of + 0 -> return False + 1 -> return True + _ -> error "TODO" + + _ -> error "TODO" + + +-- | A wrapper handle time in POSIX format. +newtype ModificationTime = ModificationTime { getModificationTime :: UTCTime } deriving (Show, Eq) + +instance FromField ModificationTime where + fromField f = (ModificationTime . posixSecondsToUTCTime . fromInteger) <$> fromField f + +instance FromJSON ModificationTime where + parseJSON = fmap (ModificationTime . posixSecondsToUTCTime . fromInteger) . parseJSON diff --git a/src/Anki/Deck.hs b/src/Anki/Deck.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Deck.hs @@ -0,0 +1,180 @@ +{-| + Module: Anki.Deck + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Representation of a deck and related definitions. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} + +module Anki.Deck ( + DeckOptions(..) + , DeckOptionsId + , DeckOptionsLapse(..) + , DeckOptionsRev(..) + , DeckOptionsNew(..) + + , Deck(..) + , DeckExtension(..) + , DeckId + ) where + + +import Anki.Common (WeaklyTypedInt, WeaklyTypedBool(..), ModificationTime, AnkiException(..)) +import Anki.Common (dropPrefixOptions, getJsonValue, fromDictionary, mkEntry) +import Data.Aeson (Value(..), FromJSON(..), genericParseJSON) +import Data.Aeson.Types ((.:), withObject) +import Database.SQLite.Simple.FromField (FromField(..)) +import GHC.Generics (Generic) + +-- | Type for deck options ids. +type DeckOptionsId = WeaklyTypedInt + +-- | Representation of deck options. +data DeckOptions = DeckOptions { + doId :: DeckOptionsId + , doAutoplay :: Value -- TODO Bool? + , doDyn :: Value -- TODO Bool? + , doLapse :: DeckOptionsLapse -- ^ TODO + , doMaxTaken :: Value -- TODO Int? + , doMod :: ModificationTime + , doName :: Value -- TODO String? + , doNew :: DeckOptionsNew -- ^ TODO + , doReplayq :: Value -- TODO Bool? + , doRev :: DeckOptionsRev -- ^ TODO + , doTimer :: Value -- TODO Int/Bool? + , doUsn :: Value -- TODO Int? + } deriving (Show, Eq, Generic) + +instance FromJSON DeckOptions where + parseJSON = genericParseJSON dropPrefixOptions + +instance FromField [DeckOptions] where + fromField f = getJsonValue f >>= fromDictionary (mkEntry doId DeckOptionsIdInconsistent) f + + +-- | Volatile fields of col.decks. +data DeckExtension + = NormalDeck { + deckBrowserCollapsed :: Value -- TODO Bool? + , deckConf :: Value -- TODO DeckOptionsId? + , deckExtendNew :: Value -- TODO Int? + , deckExtendRev :: Value -- TODO Int? + } + | DynamicDeck { + deckDelays :: Value -- TODO Int? + , deckResched :: Value -- TODO Bool? + , deckReturn :: Value -- TODO Bool? + , deckSeparate :: Value -- TODO Bool? + , deckTerms :: Value -- TODO [[wtf]]? + } deriving (Show, Eq, Generic) + +instance FromJSON DeckExtension where + parseJSON = withObject "DeckExtension" $ \o -> getBool <$> (o .: "dyn") >>= \case + False -> do + deckBrowserCollapsed <- o .: "browserCollapsed" + deckConf <- o .: "conf" + deckExtendNew <- o .: "extendNew" + deckExtendRev <- o .: "extendRev" + return NormalDeck {..} + + True -> do + deckDelays <- o .: "delays" + deckResched <- o .: "resched" + deckReturn <- o .: "return" + deckSeparate <- o .: "separate" + deckTerms <- o .: "terms" + return DynamicDeck {..} + + +-- | Options from cols.deck.dconf.lapse. +data DeckOptionsLapse = DeckOptionsLapse { + dolLeechFails :: Value -- TODO Int? + , dolMinInt :: Value -- TODO Int? + , dolDelays :: Value -- TODO [Int]? + , dolLeechAction :: Value -- TODO Int/Enum? + , dolMult :: Value -- TODO Double? + } deriving (Show, Eq, Generic) + +instance FromJSON DeckOptionsLapse where + parseJSON = genericParseJSON dropPrefixOptions + + +-- | Options from cols.deck.dconf.new. +data DeckOptionsNew = DeckOptionsNew { + donPerDay :: Value -- TODO Int? + , donDelays :: Value -- TODO (Int, Int)? + , donSeparate :: Value -- TODO Bool? + , donInts :: Value -- TODO (Int, Int, Int)? + , donInitialFactor :: Value -- TODO Double? + , donBury :: Value -- TODO Bool? + , donOrder :: Value -- TODO Int? + } deriving (Show, Eq, Generic) + +instance FromJSON DeckOptionsNew where + parseJSON = genericParseJSON dropPrefixOptions + + +-- | Options from cols.deck.dconf.rev +data DeckOptionsRev = DeckOptionsRev { + dorPerDay :: Value -- TODO Int? + , dorFuzz :: Value -- TODO Double? + , dorIvlFct :: Value -- TODO Double? + , dorMaxIvl :: Value -- TODO Double? + , dorEase4 :: Value -- TODO Double? + , dorBury :: Value -- TODO Bool? + , dorMinSpace :: Value -- TODO Int? + } deriving (Show, Eq, Generic) + +instance FromJSON DeckOptionsRev where + parseJSON = genericParseJSON dropPrefixOptions + + +-- | Type for deck ids. +type DeckId = WeaklyTypedInt + +-- | Representation of a deck. +data Deck = Deck { + deckId :: DeckId + , deckName :: Value -- TODO String? + , deckCollapsed :: Value -- TODO Bool? + , deckDesc :: Value -- TODO String? + , deckMod :: ModificationTime + , deckUsn :: Value -- TODO Int? + , deckLrnToday :: Value -- TODO (Int, Int)? + , deckNewToday :: Value -- TODO (Int, Int)? + , deckRevToday :: Value -- TODO (Int, Int)? + , deckTimeToday :: Value -- TODO (Int, Int)? + , deckExtension :: DeckExtension + } deriving (Show, Eq, Generic) + + +instance FromJSON Deck where + parseJSON = withObject "Deck" $ \o -> do + deckName <- o .: "name" + deckCollapsed <- o .: "collapsed" + deckDesc <- o .: "desc" + deckId <- o .: "id" + deckMod <- o .: "mod" + deckUsn <- o .: "usn" + deckLrnToday <- o .: "lrnToday" + deckNewToday <- o .: "newToday" + deckRevToday <- o .: "revToday" + deckTimeToday <- o .: "timeToday" + deckExtension <- parseJSON $ Object o + return Deck {..} + +instance FromField [Deck] where + fromField f = getJsonValue f >>= fromDictionary (mkEntry deckId DeckIdInconsistent) f diff --git a/src/Anki/Misc.hs b/src/Anki/Misc.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Misc.hs @@ -0,0 +1,34 @@ +{-| + Module: Anki.Misc + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Misc types. +-} + +module Anki.Misc ( + AnkiPathsConfiguration(..) + ) where + +import Data.Default (Default, def) + +-- | Paths to all required files. +data AnkiPathsConfiguration = AnkiPathsConfiguration { + apcRoot :: FilePath -- ^ Root directory of Anki + , apcPrefs :: FilePath -- ^ Name of a preference file + , apcCollection :: FilePath -- ^ Name of a collection file + , apcMediaDB :: FilePath -- ^ Name of a media database file + , apcMediaDir :: FilePath -- ^ Name of a directory with media + } deriving (Show, Eq) + +instance Default AnkiPathsConfiguration where + def = AnkiPathsConfiguration { + apcRoot = "Documents/Anki" + , apcPrefs = "prefs.db" + , apcCollection = "collection.anki2" + , apcMediaDB = "collection.media.db2" + , apcMediaDir = "collection.media" + } diff --git a/src/Anki/Model.hs b/src/Anki/Model.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Model.hs @@ -0,0 +1,83 @@ +{-| + Module: Anki.Model + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Representation of a model and related definitions. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} + +module Anki.Model ( + ModelId + , Model(..) + , ModelField(..) + , ModelTemplate(..) + ) where + +import Anki.Common (WeaklyTypedInt, ModificationTime, AnkiException(..)) +import Anki.Common (dropPrefixOptions, getJsonValue, fromDictionary, mkEntry) +import Data.Aeson (Value(..), FromJSON(..), genericParseJSON) +import Database.SQLite.Simple.FromField (FromField(..)) +import GHC.Generics (Generic) + +-- | Type for model ids. +type ModelId = WeaklyTypedInt + +-- | Model from col.models +data Model = Model { + modelId :: ModelId + , modelCss :: Value -- String? + , modelDid :: Value -- DeckId? + , modelFlds :: [ModelField] + , modelLatexPre :: Value -- TODO String? + , modelLatexPost :: Value -- TODO String? + , modelMod :: ModificationTime + , modelName :: Value -- TODO String? + , modelSortf :: Value -- TODO Int? + , modelTags :: Value -- TODO: [wtf]? + , modelTmpls :: [ModelTemplate] + , modelType :: Value -- TODO Int? + , modelUsn :: Value -- TODO Int? + , modelVers :: Value -- TODO [wtf]? + } deriving (Show, Eq, Generic) + +instance FromJSON Model where + parseJSON = genericParseJSON dropPrefixOptions + +instance FromField [Model] where + fromField f = getJsonValue f >>= fromDictionary (mkEntry modelId ModelIdInconsistent) f where + + +-- | Field from col.models.flds +data ModelField = ModelField { + mfName :: String + , mfMedia :: Value -- TODO [wtf]? + , mfSticky :: Value -- TODO Bool? + , mfRtl :: Value -- TODO Bool? + , mfOrd :: Value -- TODO Int? + , mfFont :: Value -- TODO String? + , mfSize :: Value -- TODO Int? + } deriving (Show, Eq, Generic) + +instance FromJSON ModelField where + parseJSON = genericParseJSON dropPrefixOptions + + +-- | Template from col.models.tmpls +data ModelTemplate = ModelTemplate { + mtName :: String + , mtQfmt :: Value -- TODO String? + , mtDid :: Value -- TODO DeckId? + , mtBafmt :: Value -- TODO String? + , mtAfmt :: Value -- TODO String? + , mtBqfmt :: Value -- TODO String? + , mtOrd :: Value -- TODO Int? + } deriving (Show, Eq, Generic) + +instance FromJSON ModelTemplate where + parseJSON = genericParseJSON dropPrefixOptions diff --git a/src/Anki/Note.hs b/src/Anki/Note.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Note.hs @@ -0,0 +1,73 @@ +{-| + Module: Anki.Note + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Representation of a note and related definitions. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} + +module Anki.Note ( + NoteId + , Note(..) + , NoteField(..) + ) where + +import Anki.Common (ModificationTime) +import Anki.Model (ModelId) +import Data.Char (chr) +import Data.Text (Text) +import Database.SQLite.Simple (FromRow(..), field) +import Database.SQLite.Simple.FromField (FromField(..)) +import GHC.Generics (Generic) +import qualified Data.Text as T + +-- | Type for note ids. +type NoteId = Int + +fieldSeparator :: Char +fieldSeparator = chr 0x1F + +-- | Notes from notes table. +data Note = Note { + noteId :: NoteId + , noteGuid :: String + , noteMid :: ModelId + , noteMod :: ModificationTime + , noteUsn :: Int -- TODO check type + , noteTags :: String -- TODO ? + , noteFlds :: [NoteField] + , noteSfld :: NoteField + , noteCsum :: Int -- TODO check type + , noteFlags :: Int -- TODO check type + , noteData :: String -- TODO check type + } deriving (Show, Eq, Generic) + +instance FromRow Note where + fromRow = Note + <$> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + <*> field + +-- | Representation of note fields as they store in the database. +newtype NoteField = NoteField { getNoteField :: Text } deriving (Show, Eq) + +instance FromField NoteField where + fromField f = NoteField <$> fromField f + +instance FromField [NoteField] where + fromField f = (fmap NoteField . T.split (== fieldSeparator)) <$> fromField f + diff --git a/src/Anki/Tools.hs b/src/Anki/Tools.hs new file mode 100644 --- /dev/null +++ b/src/Anki/Tools.hs @@ -0,0 +1,59 @@ +{-| + Module: Anki.Tools + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Tools to work with collection. +-} + + {-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE RecordWildCards #-} + +module Anki.Tools ( + getUserProfiles + , getCollections + , getNotes + , getCards + ) where + +import Anki.Misc +import Anki.UserProfile +import Anki.Collection +import Anki.Note +import Anki.Card +import Control.Exception (bracket) +import Database.SQLite.Simple (open, close, query_) +import System.Directory (getHomeDirectory) +import System.FilePath (joinPath) + + +-- | Extract user profiles from the given anki configuration. +getUserProfiles :: AnkiPathsConfiguration -> IO [UserProfile] +getUserProfiles (AnkiPathsConfiguration {..}) = bracket + (open =<< (joinPath . (:[apcRoot, apcPrefs]) <$> getHomeDirectory)) + (close) + (flip query_ "select name from profiles") + +-- | Extract available collections from the given profile. +getCollections :: AnkiPathsConfiguration -> UserProfile -> IO [Collection] +getCollections (AnkiPathsConfiguration {..}) (UserProfile {..}) = bracket + (open =<< (joinPath . (:[apcRoot, upName, apcCollection]) <$> getHomeDirectory)) + (close) + (flip query_ "select id, crt, mod, scm, ver, dty, usn, ls, conf, models, decks, dconf, tags from col") + +-- | Extract all notes from from the given profile. +getNotes :: AnkiPathsConfiguration -> UserProfile -> IO [Note] +getNotes (AnkiPathsConfiguration {..}) (UserProfile {..}) = bracket + (open =<< (joinPath . (:[apcRoot, upName, apcCollection]) <$> getHomeDirectory)) + (close) + (flip query_ "select id, guid, mid, mod, usn, tags, flds, sfld, csum, flags, data from notes") + +-- | Extract all cards from from the given profile. +getCards :: AnkiPathsConfiguration -> UserProfile -> IO [Card] +getCards (AnkiPathsConfiguration {..}) (UserProfile {..}) = bracket + (open =<< (joinPath . (:[apcRoot, upName, apcCollection]) <$> getHomeDirectory)) + (close) + (flip query_ "select id, nid, did, ord, mod, usn, type, queue, due, ivl, factor, reps, lapses, left, odue, odid, flags, data from cards limit 20") diff --git a/src/Anki/UserProfile.hs b/src/Anki/UserProfile.hs new file mode 100644 --- /dev/null +++ b/src/Anki/UserProfile.hs @@ -0,0 +1,27 @@ +{-| + Module: Anki.UserProfile + Copyright: (c) 2016 Al Zohali + License: BSD3 + Maintainer: Al Zohali + Stability: experimental + + = Description + Representation of a user profile and related definitions. +-} + +module Anki.UserProfile ( + UserProfile(..) + ) where + +import Database.SQLite.Simple (FromRow(..), field) + +-- | User profile as in profile table in prefs.db +data UserProfile = UserProfile { + upName :: String -- ^ Profile name (profile.name) + + -- TODO: upData :: String -- ^ profile.data + } deriving (Show, Eq) + +instance FromRow UserProfile where + fromRow = UserProfile <$> field + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE LambdaCase #-} + +import Data.Default (def) +import System.Environment (getArgs) +import Anki.Tools +import Anki.Collection +import Anki.Note +import Anki.Card +import Anki.UserProfile + + +splitArgs :: [String] -> [(String, String)] +splitArgs [] = [] +splitArgs (_:[]) = error "splitArgs failed to process args" +splitArgs (x:y:xs) = (x, y):(splitArgs xs) + +firstMatch :: (Eq a) => (b -> a) -> Maybe a -> ([b] -> b) +firstMatch f = maybe head (\x -> head . filter ((== x) . f)) + +getUserProfile :: Maybe String -> IO UserProfile +getUserProfile m = firstMatch upName m <$> getUserProfiles def + +getCollection :: UserProfile -> Maybe Int -> IO Collection +getCollection p m = firstMatch collectionId m <$> getCollections def p + +main :: IO () +main = do + args <- splitArgs <$> getArgs + + userProfile <- getUserProfile $ lookup "--user-profile" args + -- let output = show userProfile + + -- collection <- getCollection userProfile $ read <$> (lookup "--collection" args) + -- let output = show collection + + -- notes <- getNotes def userProfile + -- let output = show notes + + cards <- getCards def userProfile + let output = show cards + + putStrLn output